home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / prog_d / isamexpt.zip / ISAMBROW.PAS < prev    next >
Pascal/Delphi Source File  |  1996-04-05  |  21KB  |  601 lines
  1. unit Isambrow;
  2. {copyright 1995 by Norbert Stellberg GmbH,
  3.  parts that are signed with a "*" copyright by TURBO POWER
  4.  or Michael Williams CompuServe: 71552,757 }
  5. interface
  6.  
  7. uses
  8.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  9.   Forms, Dialogs, ExtCtrls,
  10.   LowBrows, Fvcbrows, Filer, IsamTabl;
  11.  
  12. type
  13.   Feld_GetProc = Function(Feld: Integer;
  14.                           Table: TIsamTable;
  15.                           var DATA): String;
  16.   {FELD_GETPROC will be created by the expert in
  17.    the browser-unit.
  18.    It will get the data-fields from your record.
  19.    Example:
  20.      Function TestGetFeldProc(Feld: Integer; Table: TIsamTable; var DATA): String; far;
  21.      var S: String;
  22.      begin
  23.        S:= '';
  24.        With TESTRECORD(Data) do begin
  25.        Case Feld of
  26.          1: s:= String_oem2ansi(Table.AnsiConvert,NAME1)+'^';
  27.          2: s:= String_oem2ansi(Table.AnsiConvert,NAME2)+'^';
  28.          3: s:= String_oem2ansi(Table.AnsiConvert,STREET)+'^';
  29.          4: s:= String_oem2ansi(Table.AnsiConvert,ZIP)+'^';
  30.          5: s:= String_oem2ansi(Table.AnsiConvert,CITY)+'^';
  31.          6: s:= DateStr(DATE)+'^';
  32.          7: s:= FormDezStr(AGE,10);
  33.       end;
  34.     end;
  35.     Result:= S;
  36.   end;   }
  37.  
  38.   TIsamBrowser = class(TFvcBrowser)
  39.     {a descendant of the TFVCBROWSER-Object, whose copyright is
  40.      by TURBO POWER INC.
  41.      Vars and Procs, signed by a "*" are copied from the TFVCBROWSER.
  42.      the copyright will still be held by TURBO POWER}
  43.   private
  44.     { Private declarations }
  45.     FHeader         : THeader;      {a normal header for your browser}
  46.     FSpalten        : TStringList;  {a list of TUEBERSCHRIFTOBJECTS .. see ISBRINST.INT}
  47.     FTable          : TIsamTable;   {the isamtable, that will be browsed}
  48.     FKeySection     : integer; { * Which header section are we searching on }
  49.     FSeparatorChar  : char;    { * Default '^'  }
  50.     FJustLeftChar   : char;    { * Default #255 }
  51.     FJustRightChar  : char;    { * Default #255 }
  52.     FJustCenterChar : char;    { * Default #255 }
  53.     FAllowIncss     : boolean; { * }
  54.     FIncSSColor     : TColor;  { * }
  55.     FIncSSTxtColor  : TColor;  { * }
  56.     Procedure SetTable(const Value: TIsamTable);
  57.     Procedure SetSpalten(const Value: TStringList);
  58.   protected
  59.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  60.     procedure KeyPress(var Key: Char); override;
  61.     function  WriteStringOut(var S      : BRLRowEltString;
  62.                                  LineNr : word;
  63.                                  XOfs   : integer): word; override;
  64.     procedure ShowErrorOccured(EClass: Integer); override;
  65.   public
  66.     BaseLKey    : IsamKeyStr; { * }
  67.     BaseHKey    : IsamKeyStr; { * }
  68.     IncSS       : IsamKeyStr;  { * Incremental search string }
  69.     FTextMargin : TRect;      { * }
  70.     Procedure ResizeHeader;  {must be called after you changed the
  71.                               field widths by drag and drop in your
  72.                               browser}
  73.     Function ReadIni: Integer; {will read browser-settings from an ini-file,
  74.                                {must be called after creating the form and
  75.                                 before showing the browser-form.}
  76.     Procedure SetupBrowser(aParent: TForm); {will show the browser-setup-dialog,
  77.                                 see ISBRINST.INT}
  78.     Function GetRow(GetProc: Feld_GetProc; var DATA):String;
  79.                               {called by the browser to show the data fields}
  80.     Function GetLowBrowser: PLowWinBrowser;
  81.   published
  82.     { Published declarations }
  83.     constructor Create(AOwner: TComponent); override;
  84.     destructor Destroy; override;
  85.     property BrowserHeader  : THeader read FHeader write FHeader;
  86.     property Spalten        : TStringList read FSpalten write SetSpalten;
  87.     property Table          : TIsamTable read FTable write SetTable;
  88.     property KeySection     : {*}integer read FKeySection write FKeySection;
  89.     property SeparatorChar  : {*}char read FSeparatorChar write FSeparatorChar;
  90.     property JustLeftChar   : {*}char read FJustLeftChar write FJustLeftChar;
  91.     property JustRightChar  : {*}char read FJustRightChar write FJustRightChar;
  92.     property JustCenterChar : {*}char read FJustCenterChar write FJustCenterChar;
  93.     property AllowIncSS     : {*}boolean read FAllowIncSS write FAllowIncSS;
  94.     property IncSSColor     : {*}TColor read FIncSSColor write FIncSSColor;
  95.     property IncSSTxtColor  : {*}TColor read FIncSSTxtColor write FIncSSTxtColor;
  96.     procedure ClearIncss;     {*}
  97.   end;
  98.  
  99. Function GetAppName: String;  {procedure, to get the name of your application during runtime}
  100.  
  101. implementation
  102.  
  103. Uses UToolDll, IniFiles, IsBrInst;
  104.  
  105. Var AppName: String;
  106.  
  107. Function GetAppName: String;
  108. var G: String;
  109.     xPos: Integer;
  110. begin
  111.   G:= Application.ExeName;
  112.   xPos:= Pos('\',G);
  113.   While xPos > 0 do begin
  114.     Delete(G,1,xPos);
  115.     xPos:= Pos('\',G);
  116.   end;
  117.   xPos:= Pos('.',G);
  118.   if xPos > 0 then G:= Copy(G,1,xPos-1);
  119.   AppName:= G;
  120.   GetAppName:= G;
  121. end;
  122.  
  123. constructor TIsamBrowser.Create(AOwner : TComponent);
  124. begin
  125.   Inherited Create(AOwner);
  126.   IncSS := '';
  127.   SeparatorChar := '^';
  128.   FJustLeftChar := #255;
  129.   FJustCenterChar := #255;
  130.   FJustRightChar := #255;
  131.   BaseLKey := LowKey;
  132.   BaseHKey := HighKey;
  133.   FIncSSColor := clRed;
  134.   FIncssTxtColor := clWhite;
  135.   FSpalten:= TStringList.Create;
  136. end;
  137.  
  138. Function TIsamBrowser.GetLowBrowser: PLowWinBrowser;
  139. begin
  140.   Result:= BrowserPtr;
  141. end;
  142.  
  143. Destructor TIsamBrowser.Destroy;
  144. begin
  145.   FSpalten.Free;
  146.   Inherited Destroy;
  147. end;
  148.  
  149. Function TIsamBrowser.ReadIni: Integer;
  150. var BrwListe,SListe: TStringList;
  151.     BrwIni: TIniFile;
  152.     FNr,K,i,Code,idx,Arr1,Arr2,Feld: Integer;
  153.     SStr,AktDir,LStr,LenStr,FeldName: String;
  154.     x,Len: Longint;
  155. begin
  156.   AktDir:= ExtractFilePath(Application.ExeName);
  157.   K:= 1;
  158.   BrwIni:= TIniFile.Create(AktDir + GetAppName+'.INI');
  159.   BrwListe:= TStringList.Create;
  160.   SListe:= TStringList.Create;
  161.   K:= BrwIni.ReadInteger(Name+'Key','KeyNo',1);
  162.   BrwIni.ReadSection(Name,BrwListe);
  163.   if BrwListe.Count > 0 then begin
  164.     For i:= 0 to BrwListe.Count-1 do begin
  165.       LStr:= BrwIni.ReadString(Name,BrwListe[i],'');
  166.       if Pos(',',LStr) > 0 then begin
  167.         Val(Copy(LStr,1,Pos(',',LStr)-1),Len,Code);
  168.         Delete(LStr,1,Pos(',',LStr));
  169.         Val(LStr,Idx,Code);
  170.       end
  171.       else begin
  172.         Idx:= i+1;
  173.         Val(LStr,Len,Code);
  174.       end;
  175.       SListe.AddObject(BrwListe[i],TUeberschriftObject.Init(BrwListe[i],Idx,Len));
  176.     end;
  177.     Spalten:= SListe;
  178.   end
  179.   else begin
  180.     if Table <> NIL then begin
  181.       if Table.IsamRecord.Count > 0 then begin
  182.         FNr:= 0;
  183.         For i:= 0 to Table.IsamRecord.Count-1 do begin
  184.           SStr:= Table.IsamRecord[i];
  185.           if (Pos('DUMMY',Uppercase(SStr)) = 0) and (Pos('IGNORE',Uppercase(SStr)) = 0) then begin
  186.             Len:= 0;
  187.             if Pos(':',SStr) > 0 then begin
  188.               GetArray(SStr,Arr1,Arr2);
  189.               For Feld:= Arr1 to Arr2 do begin
  190.                 FeldName:= Copy(SStr,1,Pos(':',SStr)-1);
  191.                 Strip(FeldName);
  192.                 if Arr1 <> Arr2 then FeldName:= FeldName + DezStr(Feld);
  193.                 LenStr:= Uppercase(SStr);
  194.                 Delete(LenStr,1,Pos(':',LenStr));
  195.                 Strip(LenStr);
  196.                 if Pos('ARRAY[',LenStr) > 0 then begin
  197.                   Delete(LenStr,1,Pos('ARRAY[',LenStr));
  198.                   Delete(LenStr,1,Pos(']',LenStr));
  199.                 end;
  200.                 if Pos('STRING',LenStr) > 0 then begin
  201.                   if Pos('[',LenStr) > 0 then begin
  202.                     Delete(LenStr,1,Pos('[',LenStr));
  203.                     LenStr:= Copy(LenStr,1,Pos(']',LenStr)-1);
  204.                     Val(LenStr,Len,Code);
  205.                   end
  206.                   else Len:= 255;
  207.                 end
  208.                 else if Pos('INTEGER',LenStr) > 0 then Len:= 8
  209.                 else if Pos('WORD',LenStr) > 0 then Len:= 8
  210.                 else if Pos('BYTE',LenStr) > 0 then Len:= 4
  211.                 else if Pos('LONGINT',LenStr) > 0 then Len:= 10
  212.                 else if Pos('REAL',LenStr) > 0 then Len:= 10
  213.                 else if Pos('BOOLEAN',LenStr) > 0 then Len:= 4;
  214.                 {if Len > 0 then begin}
  215.                 Inc(FNr);
  216.                 SListe.AddObject(FeldName,TUeberschriftObject.Init(FeldName,FNr,Len));
  217.                 {end;}
  218.               end;
  219.             end;
  220.           end;
  221.         end;
  222.         Spalten:= SListe;
  223.       end;
  224.     end;
  225.   end;
  226.   SListe.Free;
  227.   BrwListe.Free;
  228.   BrwIni.Free;
  229.   Result:= K;
  230. end;
  231.  
  232. (*Function TIsamBrowser.GetRow(GetProc: Feld_GetProc; var DATA):String;
  233. var S: String;
  234.     i,X,Code: Integer;
  235.     U:TUeberschriftObject;
  236. begin
  237.   S:= '';
  238.   For i:= 0 to Spalten.Count-1 do begin
  239.     if Spalten.Objects[i] <> NIL then begin
  240.       U:= TUeberschriftObject(Spalten.Objects[i]);
  241.       X:= U.Idx;
  242.       if (X > 0) and (U.Breite > 0) then S:= S + GetProc(X,Table,DATA);
  243.     end;
  244.   end;
  245.   Result:= ' '+S+#13
  246. end;*)
  247. Function TIsamBrowser.GetRow(GetProc: Feld_GetProc; var DATA):String;
  248. var S: String;
  249.     ss : String; {NS}
  250.     i,X,Code : Integer;
  251.     L,ii: Integer; {NS}
  252.     U:TUeberschriftObject;
  253.     SChar: Char;
  254. begin
  255.   S:= '';
  256.   SChar:= SeparatorChar;
  257.   For i:= 0 to Spalten.Count-1 do begin
  258.     SChar:= SeparatorChar;
  259.     if Spalten.Objects[i] <> NIL then begin
  260.       U:= TUeberschriftObject(Spalten.Objects[i]);
  261.       X:= U.Idx;
  262.       L := U.Breite; {NS}
  263.       ss := GetProc(X,Table,DATA); {NS}
  264.       ii := Pos(SChar,ss); {NS}
  265.       if ii > 0 then delete(ss,ii,1); {NS}
  266.       if Pos(JustRightChar,SS) > 0 then begin
  267.         Delete(SS,Pos(JustRightChar,SS),1);
  268.         SS:= F(SS,L)+JustRightChar + SChar;
  269.       end
  270.       else if Pos(JustLeftChar,SS) > 0 then begin
  271.         Delete(SS,Pos(JustLeftChar,SS),1);
  272.         SS:= F(SS,L)+JustLeftChar + SChar;
  273.       end
  274.       else if Pos(JustCenterChar,SS) > 0 then begin
  275.         Delete(SS,Pos(JustCenterChar,SS),1);
  276.         SS:= F(SS,L)+JustCenterChar + SChar;
  277.       end
  278.       else begin
  279.         ss := F(SS,L)+SChar;
  280.                        {NS}  {Ich bin davon ausgegangen, da▀ das Feld die LΣnge L hat zuzⁿglich das Zeichen
  281.                                ^. Das Zeichen ^ habe ich entfernt, den String auf die LΣnge L aufgefⁿllt und das Zeichen
  282.                                ^ wieder angefⁿgt. Beachte bitte, das das Zeichen ^ variabel ist und im Browser eingestellt
  283.                                werden kann. }
  284.       end;
  285.       if (X > 0) and (U.Breite > 0) then S:= S + ss; {NS}
  286.     end;
  287.   end;
  288.   Result:= ' '+S+#13
  289. end;
  290.  
  291. Procedure TIsamBrowser.SetupBrowser(aParent: TForm);
  292. begin
  293.   BrowserSetup(aParent,GetAppName,Name,Table);
  294.   ReadIni;
  295.   SetAndUpDateBrowserScreen('',0);
  296. end;
  297.  
  298. Procedure TIsamBrowser.SetTable(Const Value: TIsamTable);
  299. var FNr,i,Len,Code,Feld,Arr1,Arr2: Integer;
  300.     SStr,FeldName,LenStr: String;
  301.     SListe: TStringList;
  302. begin
  303.   FTable:= Value;
  304.   if (csDesigning in ComponentState) then begin
  305.     if Assigned(Value) then begin
  306.       if FSpalten.Count = 0 then begin
  307.         if Value.IsamRecord.Count > 0 then begin
  308.           SListe:= TStringList.Create;
  309.           FNr:= 0;
  310.           For i:= 0 to Value.IsamRecord.Count-1 do begin
  311.             SStr:= Value.IsamRecord[i];
  312.             if (Pos('DUMMY',Uppercase(SStr)) = 0) and (Pos('IGNORE',Uppercase(SStr)) = 0) then begin
  313.               Len:= 0;
  314.               if Pos(':',SStr) > 0 then begin
  315.                 GetArray(SStr,Arr1,Arr2);
  316.                 For Feld:= Arr1 to Arr2 do begin
  317.                   FeldName:= Copy(SStr,1,Pos(':',SStr)-1);
  318.                   Strip(FeldName);
  319.                   if Arr1 <> Arr2 then FeldName:= FeldName + DezStr(Feld);
  320.                   LenStr:= Uppercase(SStr);
  321.                   Delete(LenStr,1,Pos(':',LenStr));
  322.                   Strip(LenStr);
  323.                   if Pos('ARRAY[',LenStr) > 0 then begin
  324.                     Delete(LenStr,1,Pos('ARRAY[',LenStr));
  325.                     Delete(LenStr,1,Pos(']',LenStr));
  326.                   end;
  327.                   if Pos('STRING',LenStr) > 0 then begin
  328.                     if Pos('[',LenStr) > 0 then begin
  329.                       Delete(LenStr,1,Pos('[',LenStr));
  330.                       LenStr:= Copy(LenStr,1,Pos(']',LenStr)-1);
  331.                       Val(LenStr,Len,Code);
  332.                     end
  333.                     else Len:= 255;
  334.                   end
  335.                   else if Pos('INTEGER',LenStr) > 0 then Len:= 8
  336.                   else if Pos('WORD',LenStr) > 0 then Len:= 8
  337.                   else if Pos('BYTE',LenStr) > 0 then Len:= 4
  338.                   else if Pos('LONGINT',LenStr) > 0 then Len:= 10
  339.                   else if Pos('REAL',LenStr) > 0 then Len:= 10
  340.                   else if Pos('BOOLEAN',LenStr) > 0 then Len:= 4;
  341.                   {if Len > 0 then begin}
  342.                     Inc(FNr);
  343.                     SListe.AddObject(FeldName,TUeberschriftObject.Init(FeldName,FNr,Len));
  344.                   {end;}
  345.                 end;
  346.               end;
  347.             end;
  348.           end;
  349.           Spalten:= SListe;
  350.           SListe.Free;
  351.         end;
  352.       end;
  353.     end;
  354.   end;
  355. end;
  356.  
  357. procedure TIsamBrowser.SetSpalten(const Value: TStringList);
  358. var N,i,xLen,Code: Integer;
  359.     SStr,TStr: String;
  360. begin
  361.   FSpalten.Assign(Value);
  362.   if BrowserHeader <> NIL then BrowserHeader.Sections.Clear;
  363.   if Value <> NIL then begin
  364.     if FSpalten.Count > 0 then begin
  365.       n:= 0;
  366.       for i:= 0 to FSpalten.Count-1 do begin
  367.         if FSpalten.Objects[i] <> NIL then begin
  368.           with TUeberschriftObject(FSpalten.Objects[i]) do begin
  369.             SStr:= Txt;
  370.             xLen:= Breite;
  371.             if xLen > 0 then begin
  372.               if BrowserHeader <> NIL then begin
  373.                 BrowserHeader.Sections.Insert(N,SStr);
  374.                 BrowserHeader.SectionWidth[N]:= (xLen * 7)+8;
  375.                 inc(N);
  376.               end;
  377.             end;
  378.           end;
  379.         end;
  380.       end;
  381.     end;
  382.   end;
  383. end;
  384.  
  385. Procedure TIsamBrowser.ResizeHeader;
  386. var idx,I,K,Len,x: Integer;
  387.     AktDir,SStr: String;
  388.     SListe: TStringList;
  389.     BrwIni: TIniFile;
  390.     U: TUeberschriftObject;
  391. begin
  392.   AktDir:= ExtractFilePath(Application.ExeName);
  393.   if BrowserHeader <> NIL then begin
  394.     if BrowserHeader.Sections.Count > 0 then begin
  395.       SListe:= TStringList.Create;
  396.       BrwIni:= TIniFile.Create(AktDir + GetAppname+'.INI');
  397.       if Table <> NIL then K:= Table.KeyNo else K:= 1;
  398.       BrwIni.WriteInteger(Name+'Key','KeyNo',K);
  399.       if Spalten.Count > 0 then begin
  400.         for i:= 0 to Spalten.Count-1 do begin
  401.           if Spalten.Objects[i] <> NIL then begin
  402.             U:= TUeberschriftObject(Spalten.Objects[i]);
  403.             x:= BrowserHeader.Sections.Indexof(Spalten[i]);
  404.             if x > -1 then begin
  405.               Len:= Round((BrowserHeader.SectionWidth[x]-8)/7);
  406.               if Len < 0 then Len:= 0;
  407.               SStr:= BrowserHeader.Sections[x];
  408.               Idx:= U.Idx;
  409.               SListe.AddObject(SStr, TUeberschriftObject.Init(SStr,idx,Len));
  410.               SStr:= DezStr(Len)+','+DezStr(idx);
  411.               if Len > 0 then BrwIni.WriteString(Name,BrowserHeader.Sections[x],SStr);
  412.             end
  413.             else begin
  414.               SStr:= U.Txt;
  415.               Len:= U.Breite;
  416.               Idx:= U.idx;
  417.               SListe.AddObject(SStr,TueberschriftObject.Init(SStr,idx,Len));
  418.             end;
  419.           end
  420.           else Errorwindow('Object is NIL',Spalten[i]);
  421.         end;
  422.       end
  423.       else Errorwindow('Spalte is NIL','');
  424.       Spalten:= SListe;
  425.       SListe.Free;
  426.       BrwIni.Free;
  427.     end;
  428.   end;
  429.   ReadIni;
  430.   SetAndUpdateBrowserScreen('', 0);
  431. end;
  432.  
  433. procedure TIsamBrowser.ShowErrorOccured(EClass: Integer);
  434. begin
  435.   if EClass > 1 then Inherited showErrorOccured(EClass);
  436. end;
  437.  
  438. procedure TIsamBrowser.ClearIncSS;
  439. begin
  440.   { Make sure to call this before going to a new key number }
  441.   IncSS := '';
  442.   LowKey := BaseLKey;
  443.   HighKey := BaseHKey;
  444. end;
  445.  
  446. function TIsamBrowser.WriteStringOut(var S : BRLRowEltString;
  447.                                          LineNr : word;
  448.                                          XOfs : integer) : word;
  449. var
  450.     SegmentString  : string;
  451.     Just,i,j    : integer;
  452.     Rect   : TRect;
  453.     x   : integer;
  454.     SegNum : integer;
  455.     SaveFontColor,
  456.     SaveColor : TColor;
  457.  
  458.     function StUpCase(St : string) : string;
  459.     var i : integer;
  460.     begin
  461.       Result := st;
  462.       for i := 1 to length(st) do result[i] := upcase(result[i]);
  463.     end;
  464.  
  465. begin
  466.   Result := GetTextOutPosY(LineNr);
  467.  
  468.   Rect.Left := 0{1};
  469.   Rect.Top := Result;
  470.   Rect.Bottom := Result + TotalCharHeight;
  471.  
  472.   if Assigned(FHeader) then
  473.     Rect.Right := BrowserHeader.Width
  474.   else
  475.     Rect.Right := Width;
  476.  
  477.   Canvas.FillRect(Rect);
  478.  
  479.   SegmentString := '';
  480.   SegNum := 0;
  481.  
  482.   if Assigned(FHeader) then begin
  483.      BrowserHeader.Left := xOfs + Left;
  484.      BrowserHeader.Width := Width - xOfs;
  485.   end;
  486.  
  487.   Just := DT_Left;
  488.   for i := 1 to length(S) do begin
  489.     if (S[i] = JustLeftChar) then Just := DT_left else
  490.     if (S[i] = JustCenterChar) then Just := DT_Center else
  491.     if (S[i] = JustRightChar) then Just := DT_Right else
  492.     if (S[i] = SeparatorChar) or (i = length(S)) then begin
  493.       if i = length(S) then SegmentString := SegmentString + S[i];
  494.       { SegmentString now contains the segment }
  495.       Rect.Top := Result;
  496.       Rect.Bottom := Result + TotalCharHeight;
  497.       x := 1;
  498.       if Assigned(FHeader) then begin
  499.          for j := 0 to SegNum-1 do
  500.           x := x + BrowserHeader.SectionWidth[j];
  501.          Rect.Left := XOfs + FTextMargin.Left + x + 2;
  502.          if SegNum = BrowserHeader.Sections.Count-1 then
  503.            Rect.Right := Rect.Left + BrowserHeader.SectionWidth[SegNum]-20
  504.          else
  505.            Rect.Right := Rect.Left + BrowserHeader.SectionWidth[SegNum]-4;
  506.       end else begin
  507.          Rect.Left := XOfs + FTextMargin.Left + 2;
  508.          Rect.Right := XOfs + FtextMargin.Left + Width - 2;
  509.       end;
  510.  
  511.       { Draw the text }
  512.       DrawText(Canvas.Handle,@SegmentString[1],length(SegmentString),Rect,Just+DT_NoPrefix);
  513.  
  514.       { Process the incremental search string }
  515.       if (IncSS <> '') and (SegNum = KeySection) and (Just = DT_Left) and
  516.          (copy(StUpCase(SegmentString),1,Length(IncSS)) = IncSS) then begin
  517.            { Do incremental search string highlight }
  518.            SaveColor := Canvas.Brush.Color;
  519.            SaveFontColor := Canvas.Font.Color;
  520.            Canvas.Font.Color := IncSSTxtColor;
  521.            Canvas.Brush.Color := IncSSColor;
  522.            DrawText(Canvas.Handle,@SegmentString[1],length(IncSS),Rect,DT_Left+Dt_NoPrefix);
  523.            Canvas.Font.Color := SaveFontColor;
  524.            Canvas.Brush.Color := SaveColor;
  525.       end;
  526.       { Draw vertical lines }
  527.       Canvas.Pen.Color := clGray;
  528.       Rect.Right := Rect.Right + 2;
  529.       Canvas.MoveTo(Rect.Right-2,Rect.Top);
  530.       Canvas.LineTo(Rect.Right-2,Rect.Bottom);
  531.       Canvas.Pen.Color := clWhite;
  532.       Canvas.MoveTo(Rect.Right-1,Rect.Top);
  533.       Canvas.LineTo(Rect.Right-1,Rect.Bottom);
  534.       inc(SegNum);
  535.       SegmentString := '';
  536.     end else begin
  537.       SegmentString := SegmentString + S[i];
  538.     end;
  539.   end;
  540. end;
  541.  
  542. procedure TIsamBrowser.KeyDown(var Key: Word; Shift: TShiftState);
  543. var Data,Dup: Pointer;
  544. begin
  545.   inherited KeyDown(Key, Shift);
  546.   if CanCallLowBrowser then begin
  547.     case Key of
  548.       vk_Delete: if Table <> NIL then begin
  549.                    Table.Ref:= GetCurrentDatRef;
  550.                    GetMem(Data,Table.RecSize);
  551.                    GetMem(Dup,Table.RecSize);
  552.                    Table.Get(Data^,Dup^);
  553.                    Table.Delete(Data^,Dup^);
  554.                    FreeMem(Dup,Table.RecSize);
  555.                    FreeMem(Data,Table.RecSize);
  556.                    SetAndUpdateBrowserScreen(Table.Key,Table.Ref);
  557.                  end;
  558.       vk_Insert: OnDblClick(Self);
  559.     end;
  560.   end;
  561. end;
  562.  
  563. procedure TIsamBrowser.KeyPress(var Key : char);
  564. Const AllowedKeys = [' '..'z'];
  565. var SaveIncSS, SaveLowKey, SaveHighKey : IsamKeyStr;
  566. begin
  567.   if not AllowIncss then Exit;
  568.   SaveIncSS := IncSS;
  569.   if Key = #8 then begin { Backspace }
  570.     if IncSS <> '' then Delete(IncSS,Length(IncSS),1);
  571.   end else begin
  572.     if Key in AllowedKeys then IncSS := IncSS + UpCase(Key)
  573.     else begin
  574.       Messagebeep(0);
  575.       Exit;
  576.     end;
  577.   end;
  578.   if not CanCallLowBrowser then Exit;
  579.   { Changing either the low or the high key can cause use to not have any
  580.     records left to show, so if either fails, we need to undo the changes. }
  581.   try
  582.     SaveLowKey := LowKey;
  583.     LowKey := BaseLKey + IncSS;
  584.     try
  585.        SaveHighKey := HighKey;
  586.        HighKey := BaseHKey + IncSS;
  587.     except
  588.        HighKey := SaveHighKey;
  589.        LowKey := SaveLowKey;
  590.        IncSS := SaveIncSS;
  591.        MessageBeep(0);
  592.     end;
  593.   except
  594.     LowKey := SaveLowKey;
  595.     IncSS := SaveIncSS;
  596.     MessageBeep(0);
  597.   end;
  598. end;
  599.  
  600. end.
  601.